perm filename VIEWER.FAI[GEO,BGB] blob
sn#013390 filedate 1972-11-20 generic text, type T, neo UTF8
00100 TITLE VIEWER - IMAGE FORMING SUBROUTINES - JULY 1972.
00200 COMMENT /
00300
00400 IMAGE FORMING OPERATIONS;
00500 MKLOCOR;
00600 SIEVE(CAMERA,WORLD)
00700 PROJECTOR(CAMERA,WORLD)
00800 FMARK(WORLD)
00900 EMARK(WORLD)
01000 U ← ZCLIP(V1,U,V2)
01100 XYCLIP
01200 ECNT,,ELIST ← CLIPER(DPY,OWINDO,WORLD)
01300 /
01400
01500 EXTERN GETBLK,RELBLK
01600 EXTERN MKB,MKF,MKE,MKV,MKBFV
01700 EXTERN KLB,KLF,KLE,KLV
01800 EXTERN WING
01900 EXTERN ECW,ECCW,OTHER
02000 EXTERN BODY,FCW,FCCW,VCW,VCCW
02100
02200
02300 DECLARE{XL,XH,YL,YH}
02400 DECLARE{FOCAL,LDZ}
02500 DECLARE{SCALEX,SCALEY,SCALEZ}
02600 DECLARE{SOX,SOY,MAGX,MAGY}
02700 INTERN SOX,SOY,MAGX,MAGY
02800
02900 DECLARE{CAMLOCOR}
03000
03100 DECLARE{ZCCMIN}
03200 EXTERN BGND
03300
03400 DECLARE{FOLDCNT,EDGECNT}
03500 INTERN FOLDCNT,EDGECNT
00100 ;DO THE PERSPECTIVE PROJECTION.
00200 ;PROJECTOR(CAMERA,WORLD).
00300 SUBR(PROJECTOR)
00400 BEGIN PROJECTOR
00500 ACCUMULATORS{B,F,E,V,C,E0,X,XX,Y,YY,Z,ZZ}
00600
00700 ;AD HOC CLEAR THE PZZ & NZZ BITS.
00800 LAC B,ARG1
00900 I0: PBODY B,B↔TESTZ B,BBIT↔GO[LAC F,B
01000 I1: PFACE F,F↔TEST F,FBIT↔GO I0↔MARKZ F,PZZ∨NZZ↔GO I1]
01100
01200 ;GET CAMERA SCALES AND FOCAL.
01300 LAC C,ARG2
01400 LAC 7(C)↔DAC SCALEX
01500 LAC 8(C)↔DAC SCALEY
01600 LAC 9(C)↔DAC SCALEZ
01700 LAC 6(C)↔DAC FOCAL
01800 LAC 3(C)↔DAC LDZ↔SETZ ZCCMIN
01900
02000 ;GET THE CAMERA'S LOCOR.
02100 LAC C,ARG2↔LOCOR C,C↔DAC C,CAMLOCOR
02200 DAC 12,S12#↔DAC 16,S16#
02300
02400 ;FOREACH B|BεWORLD DO
02500 LAC B,ARG1
02600 L1: PBODY B,B
02700 TEST B,BBIT↔GO[LAC 12,S12↔LAC 16,S16↔RET2]
02800
02900 ;FOREACH V|BV⊗B≡V DO
03000 LAC V,B
03100 L2: PVT V,V
03200 TEST V,VBIT↔GO L1
03300
03400 ;TRANSLATE TO CAMERA LOCUS.
03500 LAC X,XWC(V)↔FSBR X,XWC(C)
03600 LAC Y,YWC(V)↔FSBR Y,YWC(C)
03700 LAC Z,ZWC(V)↔FSBR Z,ZWC(C)
03800
03900 ;ROTATE TO CAMERA ORIENTATION.
04000 DEFINE ROTATE $(QQ,Q){
04100 LAC QQ,X↔ FMPR QQ,Q$X(C)
04200 LAC Y↔ FMPR Q$Y(C)↔ FADR QQ,
04300 LAC Z↔ FMPR Q$Z(C)↔ FADR QQ,}
04400 ROTATE(XX,I);
04500 ROTATE(YY,J);
04600 ROTATE(ZZ,K);
04700
04800 ;PERSPECTIVE TRANSFORMATION.
04900 FMPR XX,SCALEX↔ FDVR XX,ZZ↔ DAC XX,XPP(V)
05000 FMPR YY,SCALEY↔ FDVR YY,ZZ↔ DAC YY,YPP(V)
05100 MOVN Z,SCALEZ↔ FDVR Z,ZZ↔ DAC Z,ZPP(V)
05200 CAMGE ZZ,ZCCMIN↔DAC ZZ,ZCCMIN
00100 ;PROJECTOR(CAMERA,WORLD) CONTINUED.
00200 ;DO Z-CLIP MARKING WRT CAMERA CENTERED COORDINATES.
00300 SLIMZ X,060760↔ANDCAM X,(V);TURN 'EM ALL OFF.
00400 TJOIN. V,V
00500 SLIMZ X,(PZZ); POSITIVE HALFSPACE BEHIND THE CAMERA.
00600 MOVN FOCAL
00700 CAMGE ZZ,0; SKIP WHEN Zcc ≥ -FOCAL.
00800 SLIMZ X,(NZZ); OTHERWISE NEGATIVE CAMERA HALFSPACE INVIEW.
00900 IORM X,(V)
01000 PED E,V
01100 LAC E0,E
01200 JUMPE E,[PFACE F,B↔IORM X,(F)↔GO L1] ;VERTEX BODY CASE.
01300 L3: PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO .+5
01400 NVT 1,E↔CAME 1,V↔GO L2 ↔NCW 1,E
01500 IORM X,(E)
01600 PFACE F,E↔IORM X,(F)
01700 NFACE F,E↔IORM X,(F)
01800 LAC E,1↔CAME E,E0↔GO L3↔GO L2
01900 BEND
00100 ;UNPROJECT(V)
00200 SUBR(UNPROJECT)
00300 BEGIN
00400 ACCUMULATORS{V,C,X,Y,Z,XX,YY,ZZ}
00500 LAC V,ARG1
00600 LAC C,CAMLOCOR
00700
00800 ;UNDO PERSPECTIVE.
00900 LACN Z,SCALEZ↔FDVR Z,ZPP(V)
01000 LAC Y,YPP(V)↔FMPR Y,Z↔FDVR Y,SCALEY
01100 LAC X,XPP(V)↔FMPR X,Z↔FDVR X,SCALEX
01200
01300 ;ROTATE BY TRANSPOSE OF CAMERA ORIENTATION.
01400 LAC XX,X↔FMPR XX,IX(C)
01500 LAC Y↔FMPR JX(C)↔FADR XX,
01600 LAC Z↔FMPR KX(C)↔FADR XX,
01700
01800 LAC YY,Y↔FMPR YY,IY(C)
01900 LAC Y↔FMPR JY(C)↔FADR YY,
02000 LAC Z↔FMPR KY(C)↔FADR YY,
02100
02200 LAC ZZ,Z↔FMPR ZZ,IZ(C)
02300 LAC Y↔FMPR JZ(C)↔FADR ZZ,
02400 LAC Z↔FMPR KZ(C)↔FADR ZZ,
02500
02600 ;TRANSLATE TO CAMERA LOCUS.
02700 FADR XX,XWC(C)↔DAC XX,XWC(V)
02800 FADR YY,YWC(C)↔DAC YY,YWC(V)
02900 FADR ZZ,ZWC(C)↔DAC ZZ,ZWC(V)
03000 RET1
03100 BEND
00100 ;FACOEF(B,FLG). FLG=0 FOR WC, FLG=-1 FOR PP.
00200 SUBR(FACOEF)
00300 BEGIN FACOEF
00400 ACCUMULATORS {Q,E,V1,V2,V3,ABC,F,ARG}
00500 EXTERN SQRT;CLOBBERS AC1 THRU AC4.
00600 FOR @% Qε{XYZ}{FOR @$ N←1,3{
00700 DEFINE Q%$N<Q%WC(V$N)>↔}}
00800 ;FOREACH F|BF⊗B≡F.
00900 LAC F,ARG2
01000 LAC ARG,(F) ;ORIGINAL ARG TYPE.
01100 TLNN ARG,(BBIT)↔GO L2
01200 L1: PFACE F,F
01300 TEST F,FBIT↔RET2
01400 ;FIRST THREE VERTICES CCW ABOUT THE FACE.
01500 L2: PED E,F
01600 SETQ(V1,{VCW,E,F})
01700 SETQ(V2,{VCCW,E,F})
01800 SETQ(E,{ECCW,E,F})
01900 SETQ(V3,{VCCW,E,F})
02000 ;FLG TRUE FOR PERSPECTIVE PROJECTED FACOEF.
02100 SKIPE ARG1
02200 GO[ADDI V1,7↔ADDI V2,7↔ADDI V3,7↔GO .+1]
02300 ;KK(F) ← X1*(Z2*Y3-Y2*Z3) + Y1*(X2*Z3-Z2*X3) + Z1*(Y2*X3-X2*Y3).
02400 LAC 1,Z2↔FMPR 1,Y3↔LAC Y2↔FMPR Z3↔FSBR 1,0↔FMPR 1,X1
02500 LAC 2,X2↔FMPR 2,Z3
02600 LAC Z2↔FMPR X3↔FSBR 2,0↔FMPR 2,Y1↔FADR 1,2
02700 LAC 3,Y2↔FMPR 3,X3
02800 LAC X2↔FMPR Y3↔FSBR 3,0↔FMPR 3,Z1↔FADR 1,3
02900 DAC 1,KK(F)
03000 ;AA(F) ← (Z1*(Y2-Y3) + Z2*(Y3-Y1) + Z3*(Y1-Y2)).
03100 LAC 1,Y2↔FSBR 1,Y3↔FMPR 1,Z1↔LAC 0,1
03200 LAC 1,Y3↔FSBR 1,Y1↔FMPR 1,Z2↔FADR 0,1
03300 LAC 1,Y1↔FSBR 1,Y2↔FMPR 1,Z3↔FADR 0,1
03400 DAC AA(F)↔FMPR↔DAC ABC
03500 ;BB(F) ← (X1*(Z2-Z3) + X2*(Z3-Z1) + X3*(Z1-Z2)).
03600 LAC 1,Z2↔FSBR 1,Z3↔FMPR 1,X1↔LAC 0,1
03700 LAC 1,Z3↔FSBR 1,Z1↔FMPR 1,X2↔FADR 0,1
03800 LAC 1,Z1↔FSBR 1,Z2↔FMPR 1,X3↔FADR 0,1
03900 DAC BB(F)↔FMPR↔FADRM ABC
04000 ;CC(F) ← (X1*(Y3-Y2) + X2*(Y1-Y3) + X3*(Y2-Y1)).
04100 LAC 1,Y3↔FSBR 1,Y2↔FMPR 1,X1↔LAC 0,1
04200 LAC 1,Y1↔FSBR 1,Y3↔FMPR 1,X2↔FADR 0,1
04300 LAC 1,Y2↔FSBR 1,Y1↔FMPR 1,X3↔FADR 0,1
04400 DAC CC(F)↔FMPR↔FADRM ABC
04500 ;NORMALIZE.
04600 PUSH P,ABC↔PUSHJ P,SQRT↔SLIMZ(<1.0>)↔FDVR 1
04700 FMPRM AA(F)↔FMPRM BB(F)↔FMPRM CC(F)↔FMPRM KK(F)
04800 TLNN ARG,(BBIT)↔RET2↔GO L1
04900 BEND
00100 ;ENORM(B) - EDGE NORMALS FROM FACE NORMALS.
00200 SUBR(ENORM)
00300 BEGIN ENORM
00400 ACCUMULATORS{E,F1,F2}
00500 LAC E,ARG1
00600 PED E,E↔TEST E,EBIT↔POP1J
00700 PFACE F1,E↔NFACE F2,E
00800 LAC AA(F1)↔FAD AA(F2)↔FSC -1↔DACN AA(E)
00900 LAC BB(F1)↔FAD BB(F2)↔FSC -1↔DACN BB(E)
01000 LAC CC(F1)↔FAD CC(F2)↔FSC -1↔DACN CC(E)
01100 GO ENORM+1
01200 BEND
01300
01400 ;VNORM(B) - VERTEX NORMALS FROM EDGE NORMALS.
01500 SUBR(VNORM)
01600 BEGIN VNORM
01700 ACCUMULATORS{V,E,E0,A,B,C}
01800 LAC V,ARG1
01900 L1: PVT V,V↔TEST V,VBIT↔POP1J
02000 PED E,V↔SKIPN E0,E↔POP1J ;VERTEX BODY CASE.
02100 SETZB 0,A↔SETZB B,C
02200 L2: FAD A,AA(E)↔FAD B,BB(E)↔FAD C,CC(E)
02300 PVT 1,E↔CAME 1,V↔GO .+3↔PCW E,E↔GO .+5
02400 NVT 1,E↔CAME 1,V↔AOJA .+5↔NCW E,E
02500 CAME E,E0↔AOJA L2↔AOS
02600 FSC 233↔FDV A,↔FDV B,↔FDV C,
02700 DAC A,XPP(V)↔DAC B,YPP(V)↔DAC C,ZPP(V)
02800 GO L1
02900 BEND
00100 ;ZCLIPF(F0)
00200 SUBR ZCLIPF
00300 BEGIN ZCLIPF
00400 GO L0
00500 DECLARE{F,E,V,V1,V2,U0,U1,U2,ENEW,F0}
00600 EXTERN MKFE,ESPLIT
00700 ;GET A PZZ VERTEX OF F0
00800 L0: LAC 1,ARG1
00900 DAC 1,F0↔DAC 1,U1↔DAC 1,F
01000 PED 0,1↔DAC E
01100
01200 L1: SETQ(E,{ECCW,E,F})
01300 SETQ(V,{VCCW,E,F})
01400 TEST 1,PZZ↔GO L1
01500
01600 ;GET FIRST NZZ VERTEX CCW AROUND F FROM E.
01700 L2: SETQ(E,{ECCW,E,F})
01800 SETQ(V,{VCCW,E,F})
01900 TEST 1,NZZ↔GO L2
02000
02100 ;MAKE Z-CLIP VERTEX.
02200 LAC 1,E↔PVT 0,1↔CAMN 0,V↔GO .+3↔CALL INVERT,E
02300 PVT 0,1↔DAC V1
02400 NVT 0,1↔DAC V2
02500 SETQ(U2,{ESPLIT,E})
02600 LAC 1,U2↔MARK 1,TEMPORARY
02700 CALL ZCLIP,V1,U2,V2
02800 CALL UNPROJECT,U2
02900 LAC 1,U2↔MARK 1,NZZ
03000
03100 ;MAKE Z-CLIP EDGE.
03200 L3: LAC 1,U1↔TEST 1,VBIT↔GO L4
03300 SETQ(ENEW,{MKFE,U1,F,U2})
03400 LAC 2,ENEW↔NFACE 1,2
03500 MARK 1,PZZ
03600 MARK 2,TEMPORARY
03700 LAC 1,F↔MARKZ 1,PZZ
03800 MARK 1,NZZ
03900 CAMN 1,F0↔RET1; .......EXIT.
04000 NFACE 1,2↔DAC 1,F
04100 MARK 1,PZZ
04200 GO .+3
04300 L4: LAC U2↔DAC U0
04400
04500 ;ADVANCE INTO THE NEXT FACE.
04600 LAC U2↔DAC U1
04700 SETQ(F,{OTHER,E,F})
04800 CAME 1,F0↔GO L2
04900 LAC U0↔DAC U2↔GO L3
05000 BEND
00100 ;FMARK(WORLD) - MARK POTENT FACES FOR OCCULT.
00200 SUBR(FMARK)
00300 BEGIN FMARK
00400 ACCUMULATORS{W,B,F,Q,R}
00500
00600 ;INITIALIZE THE WORLD'S FOUR OCCULT RINGS.
00700 LAC 1,ARG1↔SLAP 1,1
00800 DAC 1,5(1)↔DAC 1,1(1)
00900 DAC 1,2(1)↔DAC 1,3(1)
01000
01100 ;PLACE THE BACKGROUND BEHIND EVERYTHING.
01200 LACN SCALEZ↔LAC 1,ZCCMIN↔FSC 1,1↔FDVR 1
01300 LAC 1,BGND↔DAC KK(1)
01400 ;FOREACH B|BεWORLD DO
01500 LAC B,ARG1↔DAC B,BODY#
01600 L1: LAC B,BODY↔PBODY B,B↔DAC B,BODY
01700 TEST B,BBIT↔RET1
01800
01900
02000 ;FOREACH F|BF⊗B≡F DO
02100 LAC F,B
02200 L2: PFACE F,F↔DAC F,FACE#
02300 TEST F,FBIT↔GO L1
02400 HIDE F
02500 TEST F,NZZ↔GO L2
02600 TEST F,PZZ↔GO L3
02700 CALL ZCLIPF,F
02800 LAC F,FACE
02900 L3: SETOM↔CALL(FACOEF,F,0)
03000 LAC F,FACE
03100 LAC CC(F)↔FMPR LDZ
03200 CAML KK(F)↔GO L2
03300
03400 ;POTENTIALLY VISIBLE FACE.
03500 L4: MARK F,POTENT
03600 CDR R,ARG1↔CAR Q,5(R); THE POTNTF RING.
03700 DAP F,5(Q)↔DIP F,5(R)
03800 DIP Q,5(F)↔DAP R,5(F)
03900 GO L2
04000 BEND
00100 ;EMARK(WORLD) - MARK POTENT EDGES FOR OCCULT.
00200 SUBR(EMARK)
00300 BEGIN EMARK
00400 ACCUMULATORS{Q,R,S,B,F1,F2,E,A}
00500 ACCUMULATORS{V1,V2}
00600 EXTERN INVERT,SQRT
00700 SETZM FOLDCNT↔SETZM EDGECNT
00800 ;FOREACH B|BεWORLD DO
00900 LAC B,ARG1
01000 L1: PBODY B,B
01100 TEST B,BBIT↔RET1
01200 ;FOREACH E|BE⊗B≡E DO
01300 LAC E,B
01400 L2: PED E,E
01500 TEST E,EBIT↔GO L1
01600 MARKZ E,7B13
01700 PFACE F1,E
01800 NFACE F2,E
01900
02000 ;WHEN EITHER FACE IS POTENT THEN THE EDGE IS POTENT.
02100 LAC(F1)↔IOR(F2)↔TLNN(POTENT)↔GO L2
02200 MARK E,POTENT
02300 ;GET E'S ALT OR MAKE A NEW ONE.
02400 ALT A,E↔JUMPE A,[SAVAC(10)
02500 MOVEI 1,=10↔CALL GETBLK,1↔ADDI 1,3
02600 DAC 1,A↔ALT. A,E↔ALT. E,A↔GETAC(10)↔GO .+1]
02700 SETZM -1(A)↔SETZM 2(A)↔SETZM 3(A)↔ZIP(A)
02800 ;INSERT THE ALT INTO THE WORLD'S POTNTE RING.
02900 CDR R,ARG1↔CAR Q,1(R)
03000 DAP A,1(Q)↔DIP A,1(R)
03100 DIP Q,1(A)↔DAP R,1(A)
03200 AOS EDGECNT
03300 ;COMPUTE NORMALIZED EDGE COEFFICIENTS.
03400 NVT V1,E↔PVT V2,E↔MARK V1,POTENT↔MARK V2,POTENT
03500 LAC YPP(V2)↔FSBR YPP(V1)↔DAC AA(E)↔FMPR↔DAC 1
03600 LAC XPP(V1)↔FSBR XPP(V2)↔DAC BB(E)↔FMPR↔FADR 1,0
03700 LAC XPP(V2)↔FMPR YPP(V1)
03800 LAC S,XPP(V1)↔FMPR S,YPP(V2)
03900 FSBR S↔DAC CC(E)
04000 PUSH P,1↔PUSHJ P,SQRT;CLOBBERS AC1 THRU AC4.
04100 SLIMZ(<1.0>)↔FDVR 0,1
04200 FMPRM AA(E)↔FMPRM BB(E)↔FMPRM CC(E)
04300 ;WHEN ONLY ONE FACE IS POTENT THEN EDGE IS FOLDED.
04400 LAC(F1)↔XOR(F2)↔TLNN(POTENT)↔GO L2
04500 TEST F1,POTENT↔GO[CALL INVERT,E↔GO .+1];NOTA BENE !
04600 MARK E,FOLDED
04700 ;INSERT E'S ALT INTO THE WORLD'S FOLDE RING.
04800 CDR R,ARG1↔CAR Q,2(R)↔ALT A,E
04900 DAP A,2(Q)↔DIP A,2(R)
05000 DIP Q,2(A)↔DAP R,2(A)
05100 AOS FOLDCNT↔GO L2
05200 BEND
00100 ;EMARKALL(WORLD) - MARK ALL EDGES POTENT.
00200 SUBR(EMARKALL)
00300 BEGIN EMARKALL
00400 ACCUMULATORS{B,E}
00500 ;FOREACH B|BεWORLD DO
00600 LAC B,ARG1
00700 L1: PBODY B,B
00800 TEST B,BBIT↔RET1
00900 ;FOREACH E|BE⊗B≡E DO
01000 LAC E,B
01100 L2: PED E,E
01200 TEST E,EBIT↔GO L1
01300 MARK E,POTENT↔GO L2
01400 BEND
00100 ;VMARK(OWINDO,WORLD) - MARK THE NSEW BIT OF ALL THE VERTICES.
00200 VMARK: 0
00300 BEGIN VMARK
00400 ACCUMULATORS{B,E,V,X,Y}
00500
00600 ;GET THE OWINDO.
00700 LAC 1,ARG2
00800 LAC 1(1)↔DAC XL↔LAC 2(1)↔DAC XH
00900 LAC 3(1)↔DAC YL↔LAC 4(1)↔DAC YH
01000 LAC -2(1)↔DAC SOX↔LAC -1(1)↔DAC SOY
01100 LAC 7(1)↔DAC MAGX↔LAC 8(1)↔DAC MAGY
01200
01300 ;FOREACH B|BεWORLD DO
01400 LAC B,ARG1
01500 L1: PBODY B,B
01600 TEST B,BBIT↔GO @VMARK
01700
01800 ;FOREACH V|BV⊗B≡V DO
01900 LAC V,B
02000 L2: PVT V,V
02100 TEST V,VBIT↔GO L1
02200
02300 ;COMPUTE DISPLAY COORDINATES OF THE VERTEX.
02400 LAC X,XPP(V)↔FMPR X,MAGX↔FADR X,SOX↔XDC. X,V↔HLLES X
02500 LAC Y,YPP(V)↔FMPR Y,MAGY↔FADR Y,SOY↔YDC. Y,V↔HLLES Y
02600
02700 ;DO XY-CLIP MARKING.
02800 TYPE 0,V↔TRZ(NSEW);NSEW RESET.
02900 CAMLE Y,YH↔TRO(NORTH)
03000 CAMGE Y,YL↔TRO(SOUTH)
03100 CAMLE X,XH↔TRO(EAST)
03200 CAMGE X,XL↔TRO(WEST)
03300 TYPE. 0,V
03400 GO L2
03500 BEND
00100 ;SUBR ZCLIP(V1,U,V2).
00200 SUBR(ZCLIP)
00300 BEGIN ZCLIP
00400 F←0 ↔ U←1
00500 ACCUMULATORS{V1,V2,X1,Y1,Z1,X2,Y2,Z2}
00600 SAVAC(11)
00700
00800 ;V1 BEHIND CAMERA PLANE, V2 VEFORE CAMERA PLANE.
00900 CDR V1,ARG3
01000 CDR U,ARG2
01100 CDR V2,ARG1
01200 LAC F,FOCAL
01300
01400 ;UNPROJECT TO CAMERA CENTERED COORDINATES.
01500 FOR @$ I←1,2{
01600 MOVN Z$I,SCALEZ↔ FDVR Z$I,ZPP(V$I)
01700 LAC Y$I,Z$I↔ FMPR Y$I,YPP(V$I)↔ FDVR Y$I,SCALEY
01800 LAC X$I,Z$I↔ FMPR X$I,XPP(V$I)↔ FDVR X$I,SCALEX}
01900
02000 ;PIERCE Z=-FOCAL PLANE BY SIMILAR TRIANGLES & REPROJECT.
02100 FSBR X1,X2↔ FSBR Y1,Y2↔ FSBR Z1,Z2
02200 FADR Z2,F↔MOVNS Z2
02300
02400 FMPR X1,Z2↔ FDVR X1,Z1↔FADR X1,X2
02500 FMPR X1,SCALEX↔FDVR X1,F↔ DACN X1,XPP(U)
02600
02700 FMPR Y1,Z2↔ FDVR Y1,Z1↔FADR Y1,Y2
02800 FMPR Y1,SCALEY↔FDVR Y1,F ↔ DACN Y1,YPP(U)
02900 LAC 2,SCALEZ↔ FDVR 2,F↔ DAC 2,ZPP(U)
03000
03100 ;MARK U'S NSEW BITS.
03200 ACCUMULATORS{XX,YY}
03300 LAC XX,XPP(U)↔FMPR XX,MAGX↔FADR XX,SOX↔XDC. XX,U↔HLLES
03400 LAC YY,YPP(U)↔FMPR YY,MAGY↔FADR YY,SOY↔YDC. YY,U↔HLLES
03500 TYPE 0,U↔TRZ(NSEW);NSEW RESET.
03600 CAMLE YY,YH↔TRO(NORTH)
03700 CAMGE YY,YL↔TRO(SOUTH)
03800 CAMLE XX,XH↔TRO(EAST)
03900 CAMGE XX,XL↔TRO(WEST)
04000 TRZ(PZZ)↔TRO(NZZ)
04100 TYPE. 0,U
04200
04300 GETAC(11)
04400 RET3
04500 BEND
00100 ;XY-CLIPPER, SKIPS WHEN PORTION IS VISIBLE.
00200 ;EXPECTS ACCUMULATORS TO BE INITIALIZED.
00300 BEGIN XYCLIP
00400 ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR}
00500 DECLARE{A,B,C,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
00600
00700 ↑XYCLIP: 0
00800 ;GET NSEW BITS.
00900 LDB 0,[POINT 4,(V1),8];
01000 LDB 1,[POINT 4,(V2),8];
01100 ;EASY OUTSIDER EDGE.
01200 TRNE 0,(1)↔GO @XYCLIP
01300 ;GET ENDS' LOCII.
01400 XDC X1,V1↔YDC Y1,V1
01500 XDC X2,V2↔YDC Y2,V2
01600
01700 ;EASY INSIDER VERTICES.
01800 JUMPE 0,[LAC X1↔FIXX↔DIP(PTR)↔
01900 LAC Y1↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1]
02000 JUMPE 1,[LAC X2↔FIXX↔DIP(PTR)↔
02100 LAC Y2↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1↔GO L]
02200
02300 ;COMPUTE EDGE COEFFICIENTS.
02400 LAC Y1↔FSBR Y2↔DAC A
02500 LAC X2↔FSBR X1↔DAC B
02600 LAC X2↔FMPR Y1↔MOVNM C
02700 LAC X1↔FMPR Y2↔FADRM C
02800
02900 ;PARTIAL PRODUCTS.
03000 LAC A↔FMPR XH↔DAC AXH
03100 LAC A↔FMPR XL↔DAC AXL
03200 LAC B↔FMPR YH↔DAC BYH
03300 LAC B↔FMPR YL↔DAC BYL
03400
03500 ;CORNER Q'S.
03600 SETOM FLGO↔SETZM FLGZ
03700 LAC AXH↔FADR BYH↔FADR C↔DAC QNE↔ANDM FLGO↔IORM FLGZ
03800 LAC AXL↔FADR BYH↔FADR C↔DAC QNW↔ANDM FLGO↔IORM FLGZ
03900 LAC AXL↔FADR BYL↔FADR C↔DAC QSW↔ANDM FLGO↔IORM FLGZ
04000 LAC AXH↔FADR BYL↔FADR C↔DAC QSE↔ANDM FLGO↔IORM FLGZ
04100
04200 ;HARD OUTSIDER CASES.
04300 SKIPGE FLGO↔GO @XYCLIP
04400 SKIPL FLGZ↔GO @XYCLIP
00100 ;XY-CLIPPER continued.
00200 ;NORTH BORDER CROSSING.
00300 LAC QNE↔XOR QNW↔SKIPL↔GO L2
00400 LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
00500 LAC BYH↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
00600 LAC YH↔FIXX↔DAP(PTR)
00700 AOBJN PTR,.+2↔GO L
00800
00900 ;SOUTH BORDER CROSSING.
01000 L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
01100 LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
01200 LAC BYL↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
01300 LAC YL↔FIXX↔DAP(PTR)
01400 AOBJN PTR,.+2↔GO L
01500
01600 ;EAST BORDER CROSSING.
01700 L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
01800 LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
01900 LAC XH↔FIXX↔DIP(PTR)
02000 LAC AXH↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
02100 AOBJN PTR,.+2↔GO L
02200
02300 ;WEST BORDER CROSSING.
02400 L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
02500 LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
02600 LAC XL↔FIXX↔DIP(PTR)
02700 LAC AXL↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
02800 AOBJN PTR,.+2↔GO L
02900
03000 ;STRANGE EXIT - VMARK & ECOEF ARE INCONSISTENT.
03100 L5: OUTSTR[ASCIZ/XY-CLIPPER FALL THRU !
03200 /]↔ GO @XYCLIP
03300
03400 ;VISIBLE PORTION EXIT.
03500 L: AOS XYCLIP
03600 GO @XYCLIP
03700 LIT
03800 BEND
03900 ;END OF XY-CLIPPER.
00100 ; CNT,,"nbody" ELIST ← CLIPER(OWINDO,WORLD);
00200 SUBR(CLIPER)
00300 BEGIN CLIPER
00400 ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR,S12,B,LINK}
00500 JSR VMARK
00600 SETZM CNT#↔SETZ LINK,;NIL OF THE LIST.
00700
00800 ;FOREACH B|BεWORLD DO
00900 LAC B,ARG1
01000 L1: PBODY B,B
01100 TEST B,BBIT↔GO[SLAP LINK,CNT↔RET2(LINK)];
01200
01300 ;FOREACH E|BE⊗B≡E DO
01400 LAC E,B
01500 L2: PED E,E
01600 TEST E,EBIT↔GO L1
01700 TESTZ E,DARKEN↔GO L2
01800 TEST E,VISIBLE∨POTENT↔GO L2
01900
02000 ;GET THE ENDS.
02100 PVT V1,E↔NVT V2,E↔LIMZ PTR,U
02200 ;DOES EDGE NEED Z-CLIPPING.
02300 LDB 1,[POINT 2,(E),10];PICKUP PZZ/NZZ.
02400 SLIMZ(PZZ∨NZZ)↔ANDCAM(E);CLEAR 'EM.
02500 GO .+1(1); PZZ,NZZ
02600 JFCL; 0,0 - EDGE AIN'T MARKED.
02700 GO L3; 0,1 - INVIEW HALFSPACE.
02800 GO L4; 1,0 - OUT'A'SIGHT HALFSPACE.
02900 ;1,1 - NEEDS Z-CLIPPING.
03000 ;GET THE ONE INVIEW TO BE V2.
03100 TEST V2,NZZ
03200 EXCH V1,V2
03300 ;CALL SUB-CLIPPER-ROUTINES.
03400 SETQ(V1,{ZCLIP,V1,PTR,V2})
03500 L3: SLIMZ PTR,-2↔LIM PTR,-3(E)
03600 JSR XYCLIP
03700 GO [L4: MARKZ E,VISIBLE↔GO L2]
03800 ;CONS EDGE INTO VISIBLE EDGE LIST.
03900 AOS CNT#
04000 MARK E,VISIBLE
04100 DAP LINK,-1(E)
04200 LAC LINK,E
04300 GO L2
04400 ;PSEUDO VERTEX FOR Z-CLIPPER.
04500 LIT↔VAR
04600 0↔0↔0↔U: BLOCK 9
04700 BEND
00100 ;MAKE CURVY EDGED OBJECTS.
00200 SUBR(MKCURV)
00300 BEGIN MKCURV
00400 EXTERN WORLD,ESPLIT,NORM
00500 ACCUMULATORS{V,V1,V2,E}
00600 BDY←15
00700
00800 ;PUT NORMAL VECTORS ON EVERYTHING.
00900 DAC 12,TMP12#
01000 ; LAC BDY,WORLD
01100 ;L1: PBODY BDY,BDY
01200 ; TEST BDY,BBIT↔GO L2
01250 LAC BDY,ARG1
01300 SETZ↔CALL(FACOEF,BDY,0) ;WORLD COORDINATES FACE COEF.
01400 CALL(ENORM,BDY)
01500 CALL(VNORM,BDY)
01600 ; GO L1
01700
01800 ;L2: PBODY BDY,BDY
01900 ; TESTZ BDY,BBIT↔GO .+3↔LAC 12,TMP12↔POP0J
02000 LAC E,ARG1
02100 L3: PED E,E↔TEST E,EBIT↔GO L2
02200 MOVSI AA(E)↔HRRI J↔BLT J+2 ;EDGE NORMAL AS Y-AXIS.
02300 PVT V1,E↔NVT V2,E
02400 TESTZ V1,TEMPORARY↔GO L2
02500 TESTZ V2,TEMPORARY↔GO L2
02600
02700 ;EDGE FRAME ORIGIN IS THE EDGE'S MIDPOINT.
02800 LAC XWC(V1)↔FAD XWC(V2)↔FSC -1↔DAC L+0 ;ORIGIN AT EDGE MIDPOINT.
02900 LAC YWC(V1)↔FAD YWC(V2)↔FSC -1↔DAC L+1
03000 LAC ZWC(V1)↔FAD ZWC(V2)↔FSC -1↔DAC L+2
03100 ;EDGE LINE IS THE X-AXIS.
03200 LAC XWC(V1)↔FSB XWC(V2)↔DAC I+0
03300 LAC YWC(V1)↔FSB YWC(V2)↔DAC I+1
03400 LAC ZWC(V1)↔FSB ZWC(V2)↔DAC I+2
03500
03600 ;HALF EDGE LENGTH IS UNIT.
03700 LAC 0,I+0↔FMP
03800 LAC 1,I+1↔FMP 1,I+1↔FAD 1
03900 LAC 1,I+2↔FMP 1,I+2↔FAD 1
04000 CALL(SQRT,0)↔LAC 1 ;EDGE'S LENGTH.
04100 FSC 1,-1↔DAC 1,S ;SCALE UNIT.
04200 FDVR [0.30]↔FIXX↔DAC CNT# ;NUMBER OF SPACES.
04300 FSC 233↔MOVSI 1,(1.0)↔DAC 1,X# ;INITIAL X=+1.
04400 FDVR 1,0↔FSC 1,1↔DACN 1,DX#↔SOS CNT
00100 ;CROSS I-VECTOR INTO J-VECTOR TO GET K-VECTOR RIGHT-HANDED.
00200 K1: LAC 0,I+1↔FMPR 0,J+2
00300 LAC 1,J+1↔FMPR 1,I+2↔FSBR 0,1↔DAC 0,K+0
00400 LAC 0,J+0↔FMPR 0,I+2
00500 LAC 1,I+0↔FMPR 1,J+2↔FSBR 0,1↔DAC 0,K+1
00600 LAC 0,I+0↔FMPR 0,J+1
00700 LAC 1,J+0↔FMPR 1,I+1↔FSBR 0,1↔DAC 0,K+2
00800 MOVEI I↔CALL(NORM,0)
00900
01000 ;COMPUTE SLOPE M EDGE'S PVT.
01100 K2: PVT V,E
01200 LAC [XWD I,7]↔BLT 14 ;PICKUP I&J VECTORS.
01300 FMP 7,XPP(V)↔FMP 12,XPP(V) ;DOT WITH VERTEX NORMAL.
01400 FMP 10,YPP(V)↔FMP 13,YPP(V)
01500 FMP 11,ZPP(V)↔FMP 14,ZPP(V)
01600 FAD 7,10↔FAD 7,11↔FAD 12,13↔FAD 12,14
01700 FDVR 7,12↔DACN 7,M# ;SLOPE DY/DX AT PVT.
01800
01900 ;COMPUTE SLOPE N EDGE'S NVT.
02000 K3: NVT V,E
02100 LAC [XWD I,7]↔BLT 14 ;PICKUP I&J VECTORS.
02200 FMP 7,XPP(V)↔FMP 12,XPP(V) ;DOT WITH VERTEX NORMAL.
02300 FMP 10,YPP(V)↔FMP 13,YPP(V)
02400 FMP 11,ZPP(V)↔FMP 14,ZPP(V)
02500 FAD 7,10↔FAD 7,11↔FAD 12,13↔FAD 12,14
02600 FDVR 7,12↔DACN 7,N# ;SLOPE DY/DX AT NVT.
02700
02800 ;SETUP CUBIC COEFFICIENTS.
02900 K4: LAC M↔FAD N↔FSC -2
03000 DAC A#↔DACN C#
03100 LAC M↔FSB N↔FSC -2
03200 DAC B#↔DACN D#
00100 ;CREATE A VERTEX ON THE CUBIC EDGE.
00200 L4: LAC X↔FAD DX↔DAC X
00300 SETQ(V,{ESPLIT,E})
00400 MARK V,TEMPORARY
00500 ;LOCUS IN Y = ((A*X+B)*X+C)*X+D).
00600 LAC A↔FMP X↔FAD B↔FMP X↔FAD C↔FMP X↔FAD D
00700 FMP S↔DAC 7↔DAC 8↔DAC 9
00800 ;EDGE FRAME TO WORLD FRAME.
00900 FMP 7,J↔FMP 8,J+1↔FMP 9,J+2
01000 LAC 1,X↔FMP 1,S
01100 LAC I+0↔FMP 1↔FAD 7,
01200 LAC I+1↔FMP 1↔FAD 8,
01300 LAC I+2↔FMP 1↔FAD 9,
01400 FAD 7,L+0↔FAD 8,L+1↔FAD 9,L+2 ;TRANSLATE.
01500 DAC 7,XWC(V)↔DAC 8,YWC(V)↔DAC 9,ZWC(V)
01600 SOSLE CNT↔GO L4↔GO L3
01700
01800 ;EDGE FRAME OF REFERENCE.
01900 L: 0 ↔ 0 ↔ 0 ;ORIGIN.
02000 I: 0 ↔ 0 ↔ 0
02100 J: 0 ↔ 0 ↔ 0
02200 K: 0 ↔ 0 ↔ 0
02300 S: 0 ;SCALE.
02350 L2: LAC 12,TMP12↔POP1J
02400 BEND
00100 END
00200 VIEWER.FAI - EOF.